Macwelt 1

home *** CD-ROM | disk | FTP | other *** search

/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / lispMode.tcl < prev next >

Wrap

Text File | 2001-01-15 | 59.7 KB | 1,708 lines

## -*-Tcl-*- (nowrap) # ========================================================================== # Lisp Mode - an extension package for Alpha # # FILE: "lispMode.tcl" # created: 02/07/00 {12:32:35 pm} # last update: 01/15/2001 {22:38:12 PM} # Description: # # For deciphering Lisp files. # # The Scm mode could also be used for reading .el files -- Scheme is a # variant of Lisp. I didn't realize this until I was constructing the Mode # Examples Help file. Perhaps the two could be combined someday. # # Author: Craig Barton Upright # E-mail: <cupright@princeton.edu> # mail: Princeton University, Department of Sociology # Princeton, New Jersey 08544 # www: <http://www.princeton.edu/~cupright> # # ------------------------------------------------------------------- # # Copyright (c) 2000 Craig Barton Upright # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # ========================================================================== ## # =========================================================================== # # ◊◊◊◊ Initialization of Lisp mode ◊◊◊◊ # # alpha::mode Lisp 2.0 lispMenu {*.el *.elc *.lisp *.lsp} { lispMenu electricReturn electricTab electricBraces } { # We require 7.4b21 for prefs handling. alpha::package require AlphaTcl 7.4b21 addMenu lispMenu "Lisp" Lisp set modeCreator(ROSA) {Lisp} } uninstall { catch {file delete [file join $HOME Tcl Modes lispMode.tcl]} catch {file delete [file join $HOME Tcl Completions LispCompletions.tcl]} catch {file delete [file join $HOME Tcl Completions "Lisp Tutorial.el"]} catch {file delete [file join $HOME Help "Lisp Help"]} } help { file "Lisp Help" } maintainer { "Craig Barton Upright" <cupright@princeton.edu> <http://www.princeton.edu/~cupright/> } proc lispMode.tcl {} {} namespace eval Lisp {} # Make sure that Scheme mode gets loaded before the menu. if {[catch {schemeMode.tcl}]} { alertnote "The file \"schemeMode.tcl\" did not load properly.\ Perhaps it needs to be re-installed?" } # =========================================================================== # # ◊◊◊◊ Setting Lisp mode variables ◊◊◊◊ # # # Removing obsolete preferences from earlier versions. set oldvars { addLispCommands don'tRemindMe electricTab functionColor keywordColor } foreach oldvar $oldvars {prefs::removeObsolete LispmodeVars($oldvar)} unset oldvars #============================================================================= # # Standard preferences recognized by various Alpha procs # newPref var fillColumn {75} Lisp newPref var indentationAmount {4} Lisp newPref var leftFillColumn {0} Lisp newPref var prefixString {;; } Lisp newPref var wordBreak {[\w\-]+} Lisp newPref var wordBreakPreface {([^\w\-])} Lisp newPref flag wordWrap {0} Lisp #============================================================================= # # Flag preferences # # Indent all continued commands, indicated by unmatched parantheses, by the # full indentation amount rather than half. newPref flag fullIndent {1} Lisp newPref flag autoMark {0} Lisp # Set the list of flag preferences which can be changed in the menu. set LispPrefsInMenu [list \ "fullIndentLisp" \ "fullIndentScm" \ ] #============================================================================= # # Variable preferences # # Enter additional arguments to be colorized. newPref var addArguments {} Lisp {Lisp::colorizeLisp} # Enter additional Lisp commands to be colorized. newPref var addCommands {} Lisp {Lisp::colorizeLisp} # Command double-clicking on a Lisp keyword will send it to this url # for a help reference page. newPref url lispHelp {http://www.harlequin.com:8000/xanalys_int/query.html?qt=} Lisp # The "Lisp Home Page" menu item will send this url to your browser. newPref url lispHomePage {http://www.lisp.org/} Lisp # Click on "Set" to find the local Stata application. newPref sig lispSig {ROSA} Lisp # =========================================================================== # # Color preferences # newPref color argumentColor {magenta} Lisp {Lisp::colorizeLisp} newPref color commandColor {blue} Lisp {Lisp::colorizeLisp} newPref color commentColor {red} Lisp {stringColorProc} newPref color stringColor {green} Lisp {stringColorProc} newPref color symbolColor {magenta} Lisp {Lisp::colorizeLisp} regModeKeywords -e {;} \ -c $LispmodeVars(commentColor) \ -s $LispmodeVars(stringColor) Lisp {} # ========================================================================== # # Comment Character variables for Comment Line / Paragraph / Box menu items. # set Lisp::commentCharacters(General) ";; " set Lisp::commentCharacters(Paragraph) [list ";; " " ;;" " ; "] set Lisp::commentCharacters(Box) [list ";" 2 ";" 2 ";" 3] # =========================================================================== # # Flag Flip # # Called by menu items, change the value of flag preferences. # proc Lisp::flagFlip {pref} { global mode set trueMode $mode set end2 "." if {[regexp {^([a-zA-Z0-9]+[a-zA-Z0-9])(Scm|Lisp)} $pref match pref prefMode]} { set mode $prefMode set end2 " for $prefMode mode." } else { Lisp::LispModeMenuItem 1 1 } if {$mode == "Lisp"} { global LispmodeVars set LispmodeVars($pref) [expr {$LispmodeVars($pref) ? 0 : 1}] synchroniseModeVar $pref $LispmodeVars($pref) if {$LispmodeVars($pref)} { set end1 "on" } else { set end1 "off" } } elseif {$mode == "Scm"} { global ScmmodeVars set ScmmodeVars($pref) [expr {$ScmmodeVars($pref) ? 0 : 1}] synchroniseModeVar $pref $ScmmodeVars($pref) if {$ScmmodeVars($pref)} { set end1 "on" } else { set end1 "off" } } set mode $trueMode message "The \"$pref\" preference is now $end1$end2" } # =========================================================================== # # ◊◊◊◊ Keyword Dictionaries ◊◊◊◊ # # # Making sure that LispUserCommands and LispUserArguments exist. # These will be over-ridden if they are loaded from a ${mode}Prefs.tcl file. # set LispUserCommands "" set LispUserArguments "" # =========================================================================== # # ◊◊◊◊ Lisp Accessors ◊◊◊◊ # # set LispAccessors { bit car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr char compiler-macro-function eighth fifth first fourth ninth sbit schar second seventh sixth tenth third aref elt fdefinition fill-pointer find-class get getf gethash ldb logical-pathname-translations macro-function mask-field nth readtable-case rest row-major-aref subseq svref symbol-function symbol-plist symbol-value values } # =========================================================================== # # ◊◊◊◊ Lisp Classes ◊◊◊◊ # # set LispClasses { standard-object structure-object } # =========================================================================== # # ◊◊◊◊ Lisp Condition Types ◊◊◊◊ # # set LispConditionTypes { cell-error condition control-error division-by-zero end-of-file error file-error floating-point-invalid-operation floating-point-overflow floating-point-underflow floating-point-inexact package-error parse-error print-not-readable program-error reader-error serious-condition simple-condition simple-error simple-type-error simple-warning storage-condition stream-error style-warning type-error unbound-slot unbound-variable undefined-function warning } # =========================================================================== # # ◊◊◊◊ Lisp Constant Variables ◊◊◊◊ # # set LispConstantVariables { array-dimension-limit array-rank-limit array-total-size-limit boole-1 boole-2 boole-and boole-andc1 boole-andc2 boole-c1 boole-c2 boole-clr boole-eqv boole-ior boole-nand boole-nor boole-orc1 boole-orc2 boole-set boole-xor call-arguments-limit char-code-limit double-float-epsilon double-float-negative-epsilon internal-time-units-per-second lambda-list-keywords lambda-parameters-limit least-negative-double-float least-negative-long-float least-negative-normalized-double-float least-negative-normalized-long-float least-negative-normalized-short-float least-negative-normalized-single-float least-negative-short-float least-negative-single-float least-positive-double-float least-positive-long-float least-positive-normalized-double-float least-positive-normalized-long-float least-positive-normalized-short-float least-positive-normalized-single-float least-positive-short-float least-positive-single-float long-float-epsilon long-float-negative-epsilon t most-negative-double-float most-negative-fixnum most-negative-long-float most-negative-short-float most-negative-single-float most-positive-double-float most-positive-fixnum most-positive-long-float most-positive-short-float most-positive-single-float multiple-values-limit nil pi short-float-epsilon short-float-negative-epsilon single-float-epsilon single-float-negative-epsilon } # =========================================================================== # # ◊◊◊◊ Lisp Declarations ◊◊◊◊ # # set LispDeclarations { declaration dynamic-extent ftype ignore, ignorable inline notinline optimize special } # =========================================================================== # # ◊◊◊◊ Lisp Functions ◊◊◊◊ # # set LispFunctions { - 1 1+ 1- abort abs acons acos adjoin adjust-array adjustable-array-p alpha-char-p alphanumericp append apply apropos apropos-list arithmeti array-dimension array-dimensions array-displacement array-element-type array-has array-in-bounds-p array-rank array-row-major-index array-total-size arrayp ash asin assoc assoc-if-not at-arguments atan atanh bit-and bit-andc1 bit-andc2 bit-eqv bit-ior bit-nand bit-nor bit-not bit-orc1 bit-orc2 bit-vector-p bit-xor boole both-case-p boundp break broadcast butlast byte byte-position byte-size cal-pathname ceiling cell-error-name cerror char char-code char-downcase char-equal char-greaterp char-int char-lessp char-name char-not-equal char-not-greaterp char-not-lessp char-upcase character characterp cis class-of clear-input clear-output close clrhash code-char coerce compile compile-file compile-file-pathname compiled-function-p complement complex complexp compute-restarts concatenate conjugate cons consp constantly constantp continue copy-alist copy-list copy-pprint-dispatch copy-readtable copy-seq copy-structure copy-symbol copy-tree cos cosH count count-if count-if-not dable-object decode-fl decode-float decode-universal-time decoded-time delete delete-duplicates delete-file delete-if delete-if-not delete-package denominator deposit-field describe digit-char digit-char-p directory directory-namestring disassemble dpb dribble echo-stream-input-stream echo-stream => input-stream echo-stream-output-stream echo-stream output-stream ed encode-universal-time endp enough-namestring ensure-di ensure-ge eq eql equal equalp error eval evenp every exp export expt fboundp fceiling ffloor file-author file-error-pathname file-length file-namestring file-position file-string-length file-write-date fill find find-all-symbols find-if find-if-not find-package find-restart find-symbol finish-output float floatp floor fmakunbound force-output format fresh-line fround fround ftruncate funcall function-lambda-expression functionp gcd gensym gentemp get-dispatch-macro-character get-internal-real-time get-internal-run-time get-macro-character get-outpu get-properties get-setf-expansion get-unive graphic-char-p hash-table-count hash-table-p hash-table-rehash-size hash-table-rehash-threshold hash-table-size hash-table-test host-namestring identity imagpart import input-stream-p inspect integer-length integerp interactive-stream-p intern intersect intersection invalid-method-error invoke-debugger invoke-re invoke-restart isqrt keywordp last lcm ldb-test ldiff length lisp-implementation-type lisp-implementation-version list list-all-packages list-length listen listp listst ll-pointer-p load load-logi log logand logandc1 logandc2 logbitp logcount logeqv logical-pathname logior lognand lognor lognot logorc1 logorc2 logtest logxor long-site-name lower-case-p machine-instance machine-type machine-version macroexpand macroexpand-1 make-array make-broadcast-stream make-concatenated-stream make-condition make-dispatch-macro-character make-echo-stream make-hash-table make-list make-load-form-saving-slots make-package make-pathname make-random-state make-sequence make-string make-string-input-stream make-symbol make-synonym-stream make-two-way-stream makunbound map map-into mapc mapcan mapcar mapcon mapcon maphash mapl maplist max member member-if member-if-not merge merge-pathnames method-combination-error min minusp mismatch mod muffle-warning name-char name-version namestring nbutlast nconc not notany notevery nreconc nreverse nset-difference nset-exclusive-or nstring-capitalize nstring-downcase nstring-upcase nsublis nsubst nsubst-if nsubst-if-not nteractively nthcdr null numberp numerator nunion oddp open open-stream-p or-operation output-stream-p package-error-package package-name package-nicknames package-s package-use-list package-used-by-list packagep pairlis parse-integer parse-namestring pathname pathname- pathname-match-p pathnamep peek-char phase pl plusp position position-if position-if-not pprint pprint-dispatch pprint-fill pprint-indent pprint-linear pprint-newline pprint-tab pprint-tabular prin1 prin1-to-string princ princ-to-string print print-not probe-file proclaim provide random random-state-p rassoc rassoc-if rassoc-if-not rational rationalize rationalp read read-byte read-char read-char-no-hang read-delimited-list read-from-string read-line read-preserving-whitespace read-sequence readtablep realp realpart ream-streams ream-streams reduce rem remhash remove remove-duplicates remove-if remove-if-not remprop rename-file rename-package replace require restart-name revappend reverse ric-function room round rplaca rplacd search set set-difference set-dispatch-macro-character set-exclusive-or set-macro-character set-pprint-dispatch set-syntax-from-char shadow shadowing-import short-site-name signal signum simple-bit-vector-p simple-condition-format-control simple-condition-format-arguments simple-string-p simple-vector-p sin sinh sl sleep slot-boundp slot-exists-p slot-makunbound slot-value software-type software-version some sort special-operator-p sqrt st stable-sort standard-char-p store-value stream-element-type stream-error-stream stream-external-format streamp string string string-capitalize string-downcase string-equal string-greaterp string-left-trim string-lessp string-not-equal string-not-greaterp string-not-lessp string-right-trim string-trim string-upcase stringeqc stringp sublis subsetp subst subst-if subst-if-not subst-if-not substitute subtypep sxhash symbol-name symbol-package symbolp synonym-stream-symbol tailp tan terpri tories-exist translate translate-pathname translations tream-string tree-equal truename truncate two-way-stream-input-stream two-way-stream-output-stream type-error-datum type-error-expected-type type-of typep unbound-slot-instance unexport unintern union unread-char unuse-package upgraded-array-element-type upgraded-complex-part-type upper-case-p use-package use-value user-homedir-pathname values-list vector vector-pop vector-push vector-push-extend vectorp warn wild-pathname-p wing-symbols write write-byte write-char write-line write-sequence write-string write-to-string y-or-n-p yes-or-no-p zerop } # =========================================================================== # # ◊◊◊◊ Lisp Macros ◊◊◊◊ # # set LispMacros { and assert case ccase check-type cond decf declaim defclass defconstant defgeneric define-compiler-macro define-condition define-method-combination define-setf-expander define-symbol-macro defmacro defmethod defpackage defparameter defsetf defstruct deftype defun defvar destructuring-bind do do-all-symbols do-external-symbols do-symbols dolist dotimes ecase etypecase formatter handler-bind handler-case ignore-errors in-package incf lambda loop multiple-value-bind multiple-value-list multiple-value-setq nth-value or pop pprint-logical-block print-unreadable-object prog prog1 prog2 progst psetf psetq push pushnew remf restart-bind restart-case return rotatef setf shiftf step time trace typecase unless untrace when with-accessors with-compilation-unit with-condition-restarts with-hash-table-iterator with-input-from-string with-open-file with-open-stream with-output-to-string with-package-iterator with-simple-restart with-slots with-standard-io-syntax } # =========================================================================== # # ◊◊◊◊ Lisp Restarts ◊◊◊◊ # # set LispRestarts { abort continue muffle-warning } # =========================================================================== # # ◊◊◊◊ Lisp Specials ◊◊◊◊ # # set LispSpecials { flet labels macrolet multiple-value-prog1 block catch eval-when function go if let load-time-value locally multiple-value-call progn progv quote return-from setq symbol-macrolet tagbody the throw unwind-protect } # =========================================================================== # # ◊◊◊◊ Lisp Standard Generic Functions ◊◊◊◊ # # set LispStandardGenericFunctions { add-method allocate-instance change-class class-name compute-applicable-methods describe-object documentation find-method function-keywords initialize-instance make-instances-obsolete make-instance make-load-form method-qualifiers no-applicable-method no-next-method class-name print-object reinitialize-instance remove-method shared-initialize slot-missing slot-unbound update-instance-for-redefined-class update-instance-for-different-class } # =========================================================================== # # ◊◊◊◊ Lisp Symbols ◊◊◊◊ # # set LispSymbols { declare lambda } # =========================================================================== # # ◊◊◊◊ Lisp System Classes ◊◊◊◊ # # set LispSystemClasses { array bit-vector broadcast-stream built-in-class character class complex concatenated-stream cons echo-stream file-stream float function generic-function hash-table integer list logical-pathname method-combination method null number package pathname random-state ratio rational readtable real restart sequence standard-generic-function standard-class standard-method stream string-stream string structure-class symbol synonym-stream t two-way-stream vector } # =========================================================================== # # ◊◊◊◊ Lisp Types ◊◊◊◊ # # set LispTypes { atom base-char base-string bignum bit boolean compiled-function extended-char fixnum keyword nil short-float single-float double-float long-float signed-byte simple-array simple-base-string simple-bit-vector simple-string simple-vector standard-char unsigned-byte } # =========================================================================== # # ◊◊◊◊ Lisp Type Specifiers ◊◊◊◊ # # set LispTypeSpecifiers { and eql member mod not or satisfies values } # =========================================================================== # # ◊◊◊◊ Lisp Variables ◊◊◊◊ # # set LispVariables { *break-on-signals* *compile-file-pathname* *compile-file-truename* *compile-print* *compile-verbose* *debug-io* *error-output* *query-io* *standard-input* *standard-output* *trace-output* *debugger-hook* *default-pathname-defaults* *features* *gensym-counter* *load-pathname* *load-truename* *load-print* *load-verbose* *macroexpand-hook* *modules* *package* *print-array* *print-base* *print-radix* *print-case* *print-circle* *print-escape* *print-gensym* *print-level* *print-length* *print-lines* *print-miser-width* *print-pprint-dispatch* *print-pretty* *print-readably* *print-right-margin* random-statest *read-base* *read-default-float-format* *read-eval* *read-suppress* *readtable* *terminal-io* } # =========================================================================== # # ◊◊◊◊ Lisp Emacs Functions ◊◊◊◊ # # # ?? # set LispEmacsFunctions { autoload beep cs defalias defconst defcustom defdir defgroup defsubst ding force fset insert interactive mapconcat memq message prompt put setcar switch vconcat while } # =========================================================================== # # ◊◊◊◊ Lisp Emacs Arguments ◊◊◊◊ # # # ?? # set LispEmacsArguments { dirname fbuffer fname insertpos key nil node nodocs nomessage olist position switches t tbuffer } # =========================================================================== # # Colorize Lisp. # # Used to update preferences, and could be called in a <mode>Prefs.tcl file # proc Lisp::colorizeLisp {{pref ""}} { global LispmodeVars LispAccessors LispClasses LispConditionTypes global LispConstantVariables LispDeclarations LispFunctions LispMacros global LispRestarts LispSpecials LispStandardGenericFunctions LispSymbols global LispSystemClasses LispTypes LispTypeSpecifiers LispVariables global LispEmacsFunctions LispEmacsArguments global LispUserCommands LispUserArguments global LispCommandList Lispcmds # First setting aside only the commands, for Lisp::Completion::Command. set LispCommandList [concat \ $LispAccessors $LispClasses $LispConditionTypes \ $LispConstantVariables $LispDeclarations $LispFunctions \ $LispMacros $LispSpecials $LispStandardGenericFunctions \ $LispSymbols $LispSystemClasses $LispTypes $LispTypeSpecifiers \ $LispVariables \ $LispEmacsFunctions \ $LispmodeVars(addCommands) $LispUserCommands \ ] # Then, create the list of all keywords for completions. set Lispcmds [lsort [lunique [concat \ $LispCommandList \ $LispEmacsArguments \ $LispmodeVars(addArguments) $LispUserArguments \ ]]] # Commmands regModeKeywords -a -k $LispmodeVars(commandColor) \ Lisp $LispCommandList # Arguments set LispArgumentColorList [concat \ $LispEmacsArguments \ $LispmodeVars(addArguments) $LispUserArguments] regModeKeywords -a \ -k $LispmodeVars(argumentColor) Lisp $LispArgumentColorList # Symbols regModeKeywords -a \ -k $LispmodeVars(symbolColor) Lisp {} \ -i "+" -i "-" -i "*" -i "_" -i "\\" "/" \ -I $LispmodeVars(symbolColor) if {$pref != ""} {refresh} } # Call this now. Lisp::colorizeLisp # =========================================================================== # # Reload Completions. # # This is now an obsolete proc. # proc Lisp::reloadCompletions {} { alertnote "\"Lisp::reloadCompletions\" is an obsolete proc.\ It should be removed from your LispPrefs.tcl file." } # =========================================================================== # # ◊◊◊◊ Key Bindings, Electrics ◊◊◊◊ # # # abbreviations: <o> = option, <z> = control, <s> = shift, <c> = command # # Known bug: Key-bindings from other global menus might conflict with those # defined in the Lisp menu. This will help ensure that this doesn't happen. Bind 's' <cs> {Lisp::switchToLisp} Lisp Bind 'p' <cs> {Lisp::processFile} Lisp Bind 'p' <csz> {Lisp::processSelection} Lisp Bind 'n' <sz> {Lisp::nextCommand} Lisp Bind 'p' <sz> {Lisp::prevCommand} Lisp Bind 's' <sz> {Lisp::selectCommand} Lisp Bind 'c' <sz> {Lisp::copyCommand} Lisp Bind 'i' <cz> {Lisp::reformatCommand} Lisp Bind '\r' <z> {typeText "\r" } Lisp Bind '\r' <s> {Lisp::continueCommand} Lisp Bind '\)' {Lisp::electricRight "\)"} Lisp # For those that would rather use arrow keys to navigate. Up and down # arrow keys will advance to next/prev command, right and left will also # set the cursor to the top of the window. Bind up <sz> {Lisp::prevCommand} Lisp Bind left <sz> {Lisp::prevCommand 0 1} Lisp Bind down <sz> {Lisp::nextCommand} Lisp Bind right <sz> {Lisp::nextCommand 0 1} Lisp # =========================================================================== # # Lisp Carriage Return # # Inserts a carriage return, and indents properly. # proc Lisp::carriageReturn {} { global LispmodeVars if {[isSelection]} { deleteSelection } set pos1 [lineStart [getPos]] set pos2 [getPos] if {[regexp {^([\t ])*\)} [getText $pos1 $pos2]]} { createTMark temp $pos2 Lisp::indentLine gotoTMark temp ; removeTMark temp } insertText "\r" bind::IndentLine } proc Lisp::electricRight {{char "\}"}} { set pos [getPos] typeText $char if {![regexp {[^ \t]} [getText [lineStart $pos] $pos]]} { set pos [lineStart $pos] createTMark temp [getPos] Lisp::indentLine gotoTMark temp ; removeTMark temp bind::CarriageReturn } if {[catch {blink [matchIt $char [pos::math $pos - 1]]}]} { beep ; message "No matching $char !!" } } # =========================================================================== # # Continue Command # # Over-rides the automatic indentation of lines that begin with \) so that # additional text can be entered. # proc Lisp::continueCommand {} { global mode LispmodeVars ScmmodeVars indent_amounts Lisp::LispModeMenuItem Lisp::carriageReturn if {[pos::compare [getPos] != [maxPos]]} { set nextChar [getText [getPos] [pos::math [getPos] + 1]] if {$nextChar == "\)"} { if {$mode == "Lisp"} { set continueIndent [expr {$LispmodeVars(fullIndent) + 1}] } elseif {$mode == "Scm"} { set continueIndent [expr {$ScmmodeVars(fullIndent) + 1}] } insertText [text::indentOf $indent_amounts($continueIndent)] } } } # =========================================================================== # # ◊◊◊◊ Indentation ◊◊◊◊ # # # Lisp::correctIndentation is necessary for Smart Paste, and returns the # correct level of indentation for the current line. Lisp::indentLine uses # this level to indent the current line. # # Adapted from schemeMode.tcl, which includes this rationale: # # -------- # # Computing the balance of parentheses within the 'line'. # # This appears to be utterly elementary. One has to keep in mind however # that parentheses might appear in comments and/or quoted strings, in which # case they shouldn't count. Although it's easy to detect a Scheme comment # by a semicolon, a semicolon can also appear within a quoted string. Note # that a double quote isn't that sure a sign of a quoted string: the double # quote may be escaped. And the backslash can be escaped in turn... Thus # we face a full-blown problem of parsing a string according to a # context-free grammar. We note however that a TCL interpretor does # similar kind of parsing all the time. So, we can piggy-back on it and # have it decide what is the quoted string and when a semicolon really # starts a comment. To this end, we replace all non-essential characters # from the 'line' with spaces, separate all parens with spaces (so each # paren would register as a separate token with the TCL interpretor), # replace a semicolon with an opening brace (which, if unescaped and # unquoted, acts as some kind of "comment", that is, shields all symbols # that follows). After that, we get TCL interpretor to convert thus # prepared 'line' into a list, and simply count the balance of '(' and ')' # tokens. # # -------- # # Given that initial plan, I have adapted it to simply remove anything # surrounded by double quotes (taking pains to still honor literal # characters), remove valid comments, and convert the remaining parans into # "more" and "less". No need to piggy-back on the Tcl interpreter anymore. # # -- cbu # proc Lisp::indentLine {{pos ""}} { if {$pos == ""} {set pos [getPos]} # Get details of current line. set posBeg [lineStart [getPos]] set text [getText $posBeg [nextLineStart $posBeg]] regexp {^[ \t]*} $text white set posNext1 [pos::math $posBeg + [string length $white]] set posNext2 [pos::math $posNext1 + 1] if {[pos::compare $posNext2 > [maxPos]]} { set posNext2 [maxPos] } # Determine the correct level of indentation for this line, given the # next character. set lwhite [Lisp::correctIndentation $pos [getText $posNext1 $posNext2]] set lwhite [text::indentOf $lwhite] if {$white != $lwhite} { replaceText $posBeg $posNext1 $lwhite } goto [pos::math $posBeg + [string length $lwhite]] } proc Lisp::correctIndentation {pos {next ""}} { global mode indent_amounts LispmodeVars ScmmodeVars if {$mode == "Lisp"} { set continueIndent [expr {$LispmodeVars(fullIndent) + 1}] } elseif {$mode == "Scm"} { set continueIndent [expr {$ScmmodeVars(fullIndent) + 1}] } else { set continueIndent ${indent_amounts(1)} } set posBeg [lineStart $pos] # Get information about this line, previous line ... set thisLine [Lisp::getCommandLine $posBeg 1 1] set prevLine [Lisp::getCommandLine [pos::math $posBeg - 1] 0 1] set lwhite [lindex $prevLine 1] # If we have a previous line ... if {[pos::compare [lindex $prevLine 0] != $posBeg]} { # Find out if there are any unbalanced (,) in the last line. regsub -all {[^ \"\;\\]} $prevLine { } line # Remove all literals. regsub -all {\\$|\\$|\\\"|\\\;} $line { } line regsub -all {\\} $line { } line # If there is only one quote in a line, next to a closing brace, # assume that this is a continued quote from another line. So add # a double quote at the beginning of the line (which will make us # ignore everything up to that point). Not entirely foolproof ... if {![regexp {\"+.+\"} $line] && [regexp {\"([\t ]?)\)} $line]} { set line [concat \"$line] } # Remove everything surrounded by quotes. regsub -all {\"([^\"]+)\"} $line { } line regsub -all {\"} $line { } line # Remove all characters following the first valid comment. if {[regexp {\;} $line]} { set line [string range $line 0 [string first {;} $line]] } # Now turn all braces into "more" and "less" regsub -all {$} $line { more } line regsub -all {$} $line { less } line # Now indent based upon more and less. foreach i $line { if {$i == "more"} { incr lwhite $indent_amounts($continueIndent) } elseif {$i == "less"} { incr lwhite $indent_amounts(-$continueIndent) } } # Did the last line start with a lone \) ? If so, we want to keep the # indent, and not make call it an unbalanced line. if {[regexp {^[\t ]*\)} [lindex $prevLine 2]]} { incr lwhite $indent_amounts($continueIndent) } } # If we have a current line ... if {[pos::compare [lindex $thisLine 0] == $posBeg]} { # Reduce the indent if the first non-whitespace character of this # line is ) or \}. if {$next == ")" || [regexp {^[\t ]?\)} [lindex $thisLine 2]]} { incr lwhite $indent_amounts(-$continueIndent) } } # Now we return the level to the calling proc. return [expr {$lwhite > 0 ? $lwhite : 0}] } # =========================================================================== # # Get Command Line # # Find the next/prev command line relative to a given position, and return # the position in which it starts, its indentation, and the complete text # of the command line. If the search for the next/prev command fails, # return an indentation level of 0. # proc Lisp::getCommandLine {pos {direction 1} {ignoreComments 1}} { if {$ignoreComments} { set pat {^[\t ]*[^\t\r\n\; ]} } else { set pat {^[\t ]*[^\t\r\n ]} } set posBeg [pos::math [lineStart $pos] - 1] if {[pos::compare $posBeg < [minPos]]} { set posBeg [minPos] } set lwhite 0 if {![catch {search -f $direction -r 1 $pat $pos} match]} { set posBeg [lindex $match 0] set lwhite [posX [pos::math [lindex $match 1] - 1]] } set posEnd [pos::math [nextLineStart $posBeg] - 1] if {[pos::compare $posEnd > [maxPos]]} { set posEnd [maxPos] } return [list $posBeg $lwhite [getText $posBeg $posEnd]] } # =========================================================================== # # ◊◊◊◊ Command Double Click ◊◊◊◊ # # # Checks to see if the highlighted word appears in any keyword list, and if # so, sends the selected word to the www.Lisp.com help site. # # Control-Command double click will insert syntax information in status bar. # Shift-Command double click will insert commented syntax information in window. # # (The above is not yet implemented -- need to enter all of the syntax info.) # proc Lisp::DblClick {from to shift option control} { global LispmodeVars Lispcmds LispSyntaxMessage select $from $to set command [getSelect] set varDef "(def|make)+(\[-a-zA-Z0-9\]+(\[\t\' \]+$command)+\[\t\r\n \])" if {![catch {search -s -f 1 -r 1 -m 0 $varDef [minPos]} match]} { # First check current file for a function, variable (etc) # definition, and if found ... placeBookmark goto [lineStart [lindex $match 0]] message "press <Ctl .> to return to original cursor position" return # Could next check any open windows, or files in the current # window's folder ... but not implemented. For now, variables # (etc) need to be defined in current file. } if {[lsearch -exact $Lispcmds $command] == -1} { message "\"$command\" is not defined as a Lisp system keyword." return } # Any modifiers pressed? if {$control} { # CONTROL -- Just put syntax message in status bar window if {[info exists LispSyntaxMessage($command)]} { message "$LispSyntaxMessage($command)" } else { message "Sorry, no syntax information available for $command" } } elseif {$shift} { # SHIFT --Just insert syntax message as commented text if {[info exists LispSyntaxMessage($command)]} { endOfLine insertText "\r" insertText "$LispSyntaxMessage($command) comment::Line } else { message "Sorry, no syntax information available for $command" } } else { # No modifiers -- Send command for on-line help. This is the # "default" behavior. message "\"$command\" sent to $LispmodeVars(lispHelp)$command" Lisp::wwwCommandHelp $command } } # =========================================================================== # # WWW Command Help # # Send command to defined url, prompting for text if necessary. # proc Lisp::wwwCommandHelp {{command ""}} { global LispmodeVars if {$command == ""} { set command [prompt "on-line Lisp help for ... " [getSelect]] # set command [statusPrompt "on-line help for ... " ] } message "\"$command\" sent to $LispmodeVars(lispHelp)" icURL $LispmodeVars(lispHelp)$command } # =========================================================================== # # ◊◊◊◊ Mark File and Parse Functions ◊◊◊◊ # # # =========================================================================== # # Lisp Mark File # # This will return the first 35 characters from the first non-commented word # that appears in position 0. # proc Lisp::MarkFile {} { message "Marking File …" set count 0 set pos [minPos] set pat {^(;;\*;;[ ]|;;;\*;;;[ ]|\()[a-zA-Z0-9]} while {![catch {search -s -f 1 -r 1 -m 0 -i 1 $pat $pos} match]} { incr count set posBeg [lindex $match 0] set posEnd [nextLineStart $posBeg] if {[pos::compare $posEnd > [maxPos]]} {set posEnd [maxPos]} set line [string trimright [getText $posBeg $posEnd]] set line " $line" regsub -all "\{" $line "(" line regsub -all "\}" $line ")" line if {[regsub { ;;;\*;;; } $line {* } line]} { incr count -1 } elseif {[regsub { ;;\*;; } $line {• } line]} { incr count -1 } if {[string length $line] > 35} { set line "[string range $line 0 35] ..." } setNamedMark $line $posBeg $posBeg $posBeg set pos $posEnd } message "This file contains $count commands." } # =========================================================================== # # Lisp Parse Functions # # This will return only the Lisp command names. # proc Lisp::parseFuncs {} { global sortFuncsMenu set pos [minPos] set m {} while {[set match [search -s -f 1 -r 1 -i 0 -n {^\((\w+)} $pos]] != ""} { if {[regexp -- {(\w+)} [eval getText $match] "" word]} { lappend m [list $word [lindex $match 0]] } set pos [lindex $match 1] } if {$sortFuncsMenu} { regsub -all "\[\{\}\]" [lsort -ignore $m] "" m } else { regsub -all "\[\{\}\]" $m "" m } return $m } # =========================================================================== # # ◊◊◊◊ -------------------- ◊◊◊◊ # # # ◊◊◊◊ Lisp Menu ◊◊◊◊ # # proc lispMenu {} {} proc Lisp::LispModeMenuItem {{Lisp 1} {Scm 1}} { global mode set kill 1 if {$Lisp && $mode == "Lisp"} { set kill 0 } if {$Scm && $mode == "Scm"} { set kill 0 } if {$kill} { alertnote "You might have encountered a known key-binding bug,\ in which case you must use the menu bar. Otherwise, you\ selected a menu item that is not applicable to $mode files !" error "Lisp proc called, but not in applicable mode." } } # Tell Alpha what procedures to use to build all menus, submenus. menu::buildProc lispMenu Lisp::buildMenu menu::buildProc lispHelp Lisp::buildLispHelpMenu menu::buildProc markLispFileAs… Lisp::buildLispMarkMenu # First build the main Lisp menu. proc Lisp::buildMenu {} { global lispMenu set menuList [list \ "lispHomePage" \ "/S<U<OswitchToLisp" \ "(-" \ [list Menu -n lispHelp {}] \ [list Menu -n markLispFileAs… {}] \ "(-" \ "/P<U<OprocessFile" \ "/P<U<O<BprocessSelection" \ "(-" \ "/b<UcontinueCommand" \ "(-" \ "/N<U<BnextCommand" \ "/P<U<BprevCommand" \ "/S<U<BselectCommand" \ "/I<B<OreformatCommand" \ ] set submenus [list lispHelp markLispFileAs… ] return [list build $menuList Lisp::menuProc $submenus $lispMenu] } # Then build the "Lisp Help" submenu. proc Lisp::buildLispHelpMenu {} { global LispPrefsInMenu LispmodeVars ScmmodeVars alpha::platform # Reverse the local, www key bindings depending on the value of the # 'Local Help" variable. set menuList "/t<OwwwCommandHelp…" lappend menuList "(-" if {${alpha::platform} == "alpha"} { set prefix "!√" } else { set prefix "!•" } foreach item $LispPrefsInMenu { set item [lindex $item 0] if {[regsub {Lisp} $item {} pref] && \ [info exists LispmodeVars($pref)] && $LispmodeVars($pref)} { lappend menuList "${prefix}$item" } elseif {[regsub {Scm} $item {} pref] && \ [info exists ScmmodeVars($pref)] && $ScmmodeVars($pref)} { lappend menuList "${prefix}$item" } else { lappend menuList "$item" } } lappend menuList "(-" lappend menuList "checkKeywords" lappend menuList "addNewCommands" lappend menuList "addNewArguments" lappend menuList "setLispApplication" lappend menuList "(-" lappend menuList "/t<BlispModeHelp" return [list build $menuList Lisp::helpProc {}] } # Then build the "Mark Lisp File As" submenu. proc Lisp::buildLispMarkMenu {} { global LispmodeVars ScmmodeVars alpha::platform set menuList [list \ "source" \ "(-" \ ] if {${alpha::platform} == "alpha"} { set prefix "!√" } else { set prefix "!•" } foreach item [list "autoMarkLisp" "autoMarkScm"] { set item [lindex $item 0] if {[regsub {Lisp} $item {} pref] && \ [info exists LispmodeVars($pref)] && $LispmodeVars($pref)} { lappend menuList "${prefix}$item" } elseif {[regsub {Scm} $item {} pref] && \ [info exists ScmmodeVars($pref)] && $ScmmodeVars($pref)} { lappend menuList "${prefix}$item" } else { lappend menuList "$item" } } return [list build $menuList Lisp::markFileProc {}] } # Now we actually build the Lisp menu. menu::buildSome lispMenu proc Lisp::rebuildMenu {{menuName "lispMenu"}} {menu::buildSome $menuName} # Dim menu items when there are no open windows. set menuItems { markLispFileAs… continueCommand nextCommand prevCommand selectCommand reformatCommand } foreach i $menuItems { hook::register requireOpenWindowsHook [list lispMenu $i] 1 } unset menuItems # =========================================================================== # # ◊◊◊◊ Lisp menu support ◊◊◊◊ # # # We make some of these items "Lisp Mode Only", in case Scheme mode also # uses this menu. # # This is the procedure called for all main menu items. proc Lisp::menuProc {menuName item} { Lisp::$item } # Give a beta message for untested features / menu items. proc Lisp::betaMessage {{kill 1}} { message "Sorry,this feature has not been fully implemented." if {$kill} {return -code return} } # Return the Lisp signature. proc Lisp::sig {{app "Lisp"}} { global LispmodeVars set lowApp [string tolower $app] set capApp [string toupper $app] if {$LispmodeVars(${lowApp}Sig) == ""} { alertnote "Looking for the $capApp application ..." Lisp::selectApplication $lowApp } return $LispmodeVars(${lowApp}Sig) } # =========================================================================== # # Open the Lisp home page. # proc Lisp::lispHomePage {} { global LispmodeVars if {$LispmodeVars(lispHomePage) != ""} { url::execute $LispmodeVars(lispHomePage) } } # =========================================================================== # # Switch to Lisp application. # proc Lisp::switchToLisp {} {app::launchFore [Lisp::sig]} # =========================================================================== # # ◊◊◊◊ Help ◊◊◊◊ # # proc Lisp::helpProc {menuName item} { global LispmodeVars LispPrefsInMenu mode if {$item == "wwwCommandHelp"} { Lisp::LispModeMenuItem 1 1 $mode::wwwCommandHelp } elseif {[lsearch -exact $LispPrefsInMenu $item] != -1} { Lisp::flagFlip $item Lisp::rebuildMenu lispHelp } elseif {$item == "checkKeywords"} { Lisp::LispModeMenuItem 1 1 $mode::checkKeywords } elseif {$item == "addNewCommands" || $item == "addNewArguments"} { Lisp::LispModeMenuItem 1 1 set item [string trimleft $item "addNew"] $mode::addKeywords $item } elseif {$item == "setLispApplication"} { Lisp::selectApplication "Lisp" } elseif {$item == "lispModeHelp"} { package::helpFile "Lisp" } else { Lisp::$item } } proc Lisp::addKeywords {{category} {keywords ""}} { Lisp::LispModeMenuItem 1 0 global LispmodeVars if {$keywords == ""} { set keywords [prompt "Enter new Lisp mode $category:" ""] } # Check to see if the keyword is already defined. foreach keyword $keywords { set checkStatus [Lisp::checkKeywords $keyword 1 0] if {$checkStatus != 0} { alertnote "Sorry, \"$keyword\" is already defined\ in the $checkStatus list." message "Cancelled." return -code return } } # Keywords are all new, so add them to the appropriate mode preference. append LispmodeVars(add$category) " $keywords" set LispmodeVars(add$category) [lsort $LispmodeVars(add$category)] synchroniseModeVar add$category $LispmodeVars(add$category) Lisp::colorizeLisp message "\"$keywords\" added to Lisp $category preference." } proc Lisp::checkKeywords {{newKeywordList ""} {quietly 0} {noPrefs 0}} { Lisp::LispModeMenuItem 1 0 global LispmodeVars global LispAccessors LispClasses LispConditionTypes global LispConstantVariables LispDeclarations LispFunctions LispMacros global LispRestarts LispSpecials LispStandardGenericFunctions LispSymbols global LispSystemClasses LispTypes LispTypeSpecifiers LispVariables global LispEmacsFunctions LispEmacsArguments global LispUserCommands LispUserArguments set type 0 if {$newKeywordList == ""} { set quietly 0 set newKeywordList [prompt "Enter Lisp mode keywords to be checked:" ""] } # Check to see if the new keyword(s) is already defined. foreach newKeyword $newKeywordList { if {[lsearch -exact $LispAccessors $newKeyword] != "-1"} { set type LispAccessors } elseif {[lsearch -exact $LispClasses $newKeyword] != "-1"} { set type LispClasses } elseif {[lsearch -exact $LispConditionTypes $newKeyword] != "-1"} { set type LispConditionTypes } elseif {[lsearch -exact $LispConstantVariables $newKeyword] != "-1"} { set type LispConstantVariables } elseif {[lsearch -exact $LispDeclarations $newKeyword] != "-1"} { set type LispDeclarations } elseif {[lsearch -exact $LispFunctions $newKeyword] != "-1"} { set type LispFunctions } elseif {[lsearch -exact $LispMacros $newKeyword] != "-1"} { set type LispMacros } elseif {[lsearch -exact $LispRestarts $newKeyword] != "-1"} { set type LispRestarts } elseif {[lsearch -exact $LispSpecials $newKeyword] != "-1"} { set type LispSpecials } elseif {[lsearch -exact $LispStandardGenericFunctions $newKeyword] != "-1"} { set type LispStandardGenericFunctions } elseif {[lsearch -exact $LispSymbols $newKeyword] != "-1"} { set type LispSymbols } elseif {[lsearch -exact $LispSystemClasses $newKeyword] != "-1"} { set type LispSystemClasses } elseif {[lsearch -exact $LispTypes $newKeyword] != "-1"} { set type LispTypes } elseif {[lsearch -exact $LispTypeSpecifiers $newKeyword] != "-1"} { set type LispTypeSpecifiers } elseif {[lsearch -exact $LispVariables $newKeyword] != "-1"} { set type LispVariables } elseif {[lsearch -exact $LispEmacsFunctions $newKeyword] != "-1"} { set type LispEmacsFunctions } elseif {[lsearch -exact $LispEmacsArguments $newKeyword] != "-1"} { set type LispEmacsArguments } elseif {[lsearch -exact $LispUserCommands $newKeyword] != "-1"} { set type LispUserCommands } elseif {[lsearch -exact $LispUserArguments $newKeyword] != "-1"} { set type LispUserArguments } elseif {!$noPrefs && \ [lsearch -exact $LispmodeVars(addCommands) $newKeyword] != "-1"} { set type LispmodeVars(addCommands) } elseif {!$noPrefs && \ [lsearch -exact $LispmodeVars(addArguments) $newKeyword] != "-1"} { set type LispmodeVars(addArguments) } if {$quietly} { # When this is called from other code, it should only contain # one keyword to be checked, and we'll return it's type. return "$type" } elseif {!$quietly && $type == 0} { alertnote "\"$newKeyword\" is not currently defined\ as a Lisp mode keyword" } elseif {$type != 0} { # This will work for any other value for "quietly", such as "2" alertnote "\"$newKeyword\" is currently defined as a keyword\ in the \"$type\" list." } set type 0 } } # =========================================================================== # # Select Application # # Prompt the user to locate the local Lisp application. # proc Lisp::selectApplication {{app "Lisp"}} { global LispmodeVars set lowApp [string tolower $app] set capApp [string toupper $app] set newSig "" set newSig [dialog::askFindApp $capApp $LispmodeVars(${lowApp}Sig)] if {$newSig != ""} { set LispmodeVars(${lowApp}Sig) "$newSig" synchroniseModeVar "${lowApp}Sig" $LispmodeVars(${lowApp}Sig) message "The $capApp signature has been changed to \"$newSig\"." } else { message "Cancelled." } } # =========================================================================== # # ◊◊◊◊ Marks ◊◊◊◊ # # proc Lisp::markFileProc {menu item} { if {$item == "source"} { markFile } elseif {[regexp {autoMark} $item]} { Lisp::flagFlip $item Lisp::rebuildMenu markLispFileAs… } } # =========================================================================== # # ◊◊◊◊ Processing ◊◊◊◊ # # # =========================================================================== # # Process File # # Send entire file to Lisp for processing, adding carriage return at end # of file if necessary. # # Optional "f" argument allows this to be called by other code, or to be # sent via a Tcl shell window. # proc Lisp::processFile {{f ""} {app "Lisp"}} { global tcl_platform set pf $tcl_platform(platform) if {$f != ""} {file::openAny $f} getWinInfo myArray set theLastChar [getText [pos::math [maxPos] -1] [maxPos]] if {$theLastChar != "\r"} { set myPos [getPos] goto [maxPos] insertText "\r" goto $myPos # If window not originally dirty, remind user why s/he is being # asked to save file. if {!$myArray(dirty)} { alertnote "Carriage return added to end of file." } } openAndSendFile [Lisp::sig] } # Procedure to implement transfer of selected lines to Lisp for processing. # =========================================================================== # # Process Selection # proc Lisp::processSelection {{app "Lisp"}} { Lisp::betaMessage global PREFS if {[isSelection]} { set stuffToDo [getSelect] if {![file exists [file join $PREFS tmp]]} { file mkdir [file join $PREFS tmp] } set newFile [file join $PREFS tmp temp-Lisp.lisp] file::writeAll $newFile $stuffToDo 1 } else { beep ; message "No selection -- cancelled." return } app::launchBack [Lisp::sig] sendOpenEvent noReply [Lisp::sig] $newFile switchTo [Lisp::sig] } # =========================================================================== # # ◊◊◊◊ Navigation ◊◊◊◊ # # proc Lisp::nextCommand {{quietly 0} {toTop 0}} { Lisp::LispModeMenuItem set pos [pos::math [nextLineStart [getPos]] - 1] set pat {^\([a-zA-Z0-9;]} if {![catch {search -f 1 -r 1 $pat $pos} match]} { set pos [lindex $match 0] } else { set pos [maxPos] } if {!$quietly} { goto $pos if {$pos == [maxPos]} { message "No further commands in the file." } else { message [getText $pos [nextLineStart $pos]] } } if {$toTop} {insertToTop} return $pos } proc Lisp::prevCommand {{quietly 0} {toTop 0}} { Lisp::LispModeMenuItem set pos [pos::math [getPos] - 1] set pat {^\([a-zA-Z0-9;]} if {![catch {search -f 0 -r 1 $pat $pos} match]} { set pos [lindex $match 0] } else { set pos [minPos] } if {!$quietly} { goto $pos if {$pos == [minPos]} { message "No further commands in the file." } else { message [getText $pos [nextLineStart $pos]] } } if {$toTop} {insertToTop} return $pos } proc Lisp::searchFunc {direction} { Lisp::LispModeMenuItem if {$direction} { Lisp::nextCommand } else { Lisp::prevCommand } } proc Lisp::selectCommand {} { Lisp::LispModeMenuItem set pos [getPos] set limits [Lisp::getCommand $pos] set posBeg [lindex $limits 0] set posEnd [lindex $limits 1] if {$posBeg != "-1" && $posEnd != "-1" && \ [pos::compare $pos >= $posBeg] && [pos::compare $pos <= $posEnd]} { select $posBeg $posEnd } else { message "The cursor is not within a command." error "The cursor is not within a command." } } proc Lisp::copyCommand {{quietly 0}} { Lisp::LispModeMenuItem set pos [getPos] if {[set posBeg [lindex [Lisp::getCommand $pos] 0]] != "-1"} { set posBeg [pos::math $posBeg + 1] goto $posBeg forwardWord set posEnd [getPos] if {!$quietly} { select $posBeg $posEnd copy message "\"[getText $posBeg $posEnd]\" copied to clipboard." } goto $pos return [getText $posBeg $posEnd] } elseif {!$quietly} { message "The cursor is not within a command." } return "" } proc Lisp::reformatCommand {{pos ""}} { Lisp::LispModeMenuItem if {$pos == ""} {set pos [getPos]} goto $pos Lisp::selectCommand message "Reformatting …" ::indentRegion goto [pos::math [getPos] -1] goto [Lisp::nextCommand 1] message "Reformatted." } proc Lisp::getCommand {pos {backToPos 1}} { set pos1 [pos::math [nextLineStart $pos] - 1] set pat {^((\([a-zA-Z0-9])|\;)} set posBeg "-1" set posEnd "-1" if {![catch {search -f 0 -r 1 $pat $pos1} match]} { set posBeg [lindex $match 0] set pos2 [nextLineStart $posBeg] if {![catch {search -f 1 -r 1 $pat $pos2} match]} { set posEnd [lindex $match 0] } else { set posEnd [maxPos] } # Now back up to remove empty lines. set posEndPrev [pos::math $posEnd - 1] set prevLine [getText [lineStart $posEndPrev] $posEndPrev] while {[regexp {^[\t ]*$} $prevLine]} { set posEnd [lineStart $posEndPrev] set posEndPrev [pos::math $posEnd - 1] set prevLine [getText [lineStart $posEndPrev] $posEndPrev] } } return [list $posBeg $posEnd] } # =========================================================================== # # ◊◊◊◊ -------------------- ◊◊◊◊ # # # ◊◊◊◊ version history ◊◊◊◊ # # # modified by rev reason # -------- --- ------ ----------- # 01/28/20 cbu 1.0.1 First created Lisp mode, based upon other modes found # in Alpha's distribution, by looking at the syntax of # Emacs Speaks Statistics (ESS) suite. # 04/01/20 cbu 1.0.2 Fixed a little bug with "comment box". # Added new preferences to allow the user to optionally # use $ as a Magic Character, and to enter additional # commands and arguments. # Renamed mode Lisp, from lisp # Reduced the number of different user-specified colors. # 04/08/00 cbu 1.0.3 Added "Update Colors" proc to avoid need for a restart # 04/16/00 cbu 1.0.4 Unset obsolete preferences from earlier versions. # Added "Continue Comment" and "Electric Return Over-ride". # Renamed "Update Colors" to "Update Preferences". # 04/16/00 cbu 1.1 Renamed to lispMode.tcl # Added "Mark File" and "Parse Functions" procs. # 06/22/00 cbu 1.2 "Mark File" now recognizes headings as well as commands. # Completions, Completions Tutorial added. # "Reload Completions", referenced by "Update Preferences". # Better support for user defined keywords. # Removed "Continue Comment", now global in Alpha 7.4. # Added command double-click for on-line help. # <shift, control>-<command> double-click syntax info. # (Foundations, at least. Ongoing project.) # Lisp-Mode split off from Statistical Modes. # 08/08/00 cbu 1.2.1 Added message if no matching ")". # DblClick now looks for function, variable (etc) # definitions in current file. # 11/05/00 cbu 1.3 Added Lisp menu. # Lisp menu is fully functional for Scheme mode, too. # Added "next/prevCommand", "selectCommand", and # "copyCommand" procs. # Added "Lisp::indentLine". # Added "Lisp::reformatCommand" to menu. # Added "Lisp::continueCommand" to over-ride indents. # "Lisp::reloadCompletions" is now obsolete. # "Lisp::updatePreferences" is now obsolete. # "Lisp::colorizeLisp" now takes care of setting all # keyword lists, including Lispcmds. # Cleaned up completion procs. This file never has to be # reloaded. (Similar cleaning up for "Lisp::DblClick"). # 11/30/00 cbu 1.4 Fix to Lisp menu, suggested by Tom Fetherston, to make # sure that the menu builds even if prefs don't exist. # 12/01/00 cbu 2.0 New url prefs handling requires 7.4b21 # Added "Home Page" pref, menu item. # Removed hook::register requireOpenWindowsHook from # mode declaration, put it after menu build. # # =========================================================================== # # .